home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagg_m.zip / MISC.SWG / 0130_UUencoding.pas < prev   
Pascal/Delphi Source File  |  1995-02-28  |  4KB  |  171 lines
  1. {
  2.  
  3. This is the fastest I could come up with ; I suspect it's fairly
  4. faster than the one that was posted earlier. Going still faster
  5. would require some change in the algorithm, which I'm much to
  6. lazy to go through <g>.
  7.  
  8. Beware, this program does not check before overwritting an existing
  9. .uue file. Generally speaking, the error checking is quite light.
  10. }
  11.  
  12. {$r-,s-,q-}    { for the sake of speed only }
  13.  
  14. Uses DOS ;
  15.  
  16. Const
  17.      LongueurLigne  = 60 ;         { max length of output line }
  18.      Masque6bits    = $3f ;        { mask for six lower bits }
  19.      BufSize        = 2048 ;       { size of input buffer }
  20.      Espace         = 32 ;
  21.  
  22. Var  InBuf     : Array[0..BufSize] Of Byte ; { [0] is unused but necessary }
  23.      InPtr     : Word ;            { pointer in input buffer }
  24.      InQty     : Word ;            { # of bytes available in input buffer }
  25.      InFile    : File ;            { input file }
  26.      OutSt     : String ;          { output string }
  27.      OutFile   : Text ;            { output file }
  28.      SrcBytes  : Byte ;            { number of source bytes in current line }
  29.  
  30. Procedure RefillBuffer ;
  31. { Refills the buffer from the input file ; properly sets InQty and InPtr }
  32. Begin
  33.      BlockRead(InFile, InBuf[1], BufSize, InQty) ;
  34.      InPtr:=0 ;
  35. End ;
  36.  
  37. Function GetByte : Byte ; Assembler ;
  38. { Fetches a byte from the input file (i.e. input buffer) }
  39. { Only AL and SI are modified by this function }
  40. Asm
  41.      Mov  SI, InPtr
  42.      Cmp  SI, InQty
  43.      JL   @1
  44.      PushA
  45.      Call ReFillBuffer
  46.      PopA
  47. @1:
  48.      Inc  InPtr
  49.      Mov  SI, InPtr
  50.      Cmp  SI, InQty
  51.      JLE  @2
  52.      XOr  AL, AL
  53.      Jmp  @3
  54. @2:
  55.      Mov  AL, [SI+Offset InBuf]
  56.      Inc  SrcBytes
  57. @3:
  58. End ;
  59.  
  60. Procedure FlushOutSt ;
  61. { Flushes the current line to the output file }
  62. Begin
  63.      OutSt[1]:=Chr(Espace+SrcBytes) ;
  64.      WriteLn(OutFile, OutSt) ;
  65.      OutSt:=' ' ;
  66.      SrcBytes:=0 ;
  67.      Write('.') ;
  68. End ;
  69.  
  70. Procedure PutByte ; Assembler ;
  71. { Sends a byte to the output file (i.e. the output buffer) }
  72. { modifies only AL and SI ; parameter in AL }
  73. Asm
  74.      Add  AL, Espace
  75.      Cmp  AL, Espace
  76.      JNE  @1
  77.      Mov  AL, '`'
  78. @1:
  79.      Inc  Byte Ptr OutSt      { increments string length }
  80.      Mov  BL, Byte Ptr OutSt
  81.      XOr  BH, BH              { BX <- Length(OutSt) }
  82.      Mov  Byte Ptr OutSt[BX], AL
  83.      Cmp  BX, LongueurLigne
  84.      JNG  @2
  85.      PushA
  86.      Call FlushOutSt
  87.      PopA
  88. @2:
  89. End ;
  90.  
  91. Procedure EncodeFile ;
  92. { Converts a binary file to a .uue file }
  93. Var  a, b, c   : Byte ;            { three-bytes buffer }
  94. Begin
  95.      Repeat
  96.           Asm
  97.                { remember, GetByte and PutByte modify only AL and SI }
  98.  
  99.                Call GetByte
  100.                Mov  DH, AL         { first byte in DH }
  101.                Call GetByte
  102.                Mov  DL, AL         { second byte in DL }
  103.                Call GetByte
  104.                Mov  CH, AL         { third byte in CH }
  105.  
  106.                Mov  AL, DH
  107.                ShR  AL, 2
  108.                Call PutByte
  109.  
  110.                Mov  AX, DX
  111.                ShR  AX, 4
  112.                And  AL, Masque6bits
  113.                Call PutByte
  114.  
  115.                Mov  AH, DL
  116.                Mov  AL, CH
  117.                ShR  AX, 6
  118.                And  AL, Masque6bits
  119.                Call PutByte
  120.  
  121.                Mov  AL, CH
  122.                And  AL, Masque6bits
  123.                Call PutByte
  124.           End ;
  125.      Until (EOF(InFile) And (InPtr>=InQty)) ;
  126. End ;
  127.  
  128. Procedure Initialise ;
  129. { Initializes the stuff }
  130. Var  Rep  : DirStr ;
  131.      Nom  : NameStr ;
  132.      Ext  : ExtStr ;
  133. Begin
  134.      InPtr:=0 ;
  135.      InQty:=0 ;
  136.      Assign(InFile, ParamStr(1)) ;
  137.      ReSet(InFile, 1) ;
  138.      FSplit(ParamStr(1), Rep, Nom, Ext) ;
  139.      Assign(OutFile, Rep+Nom+'.UUE') ;
  140.      ReWrite(OutFile) ;
  141.      OutSt:=' ' ;
  142.      SrcBytes:=0 ;
  143.      WriteLn(OutFile, 'begin 644 ', Nom, Ext) ;
  144. End ;
  145.  
  146. Procedure Termine ;
  147. { Terminate the job }
  148. Begin
  149.      If Length(OutSt)>1 Then
  150.      Begin
  151.           OutSt[1]:=Chr(Espace+SrcBytes) ;
  152.           WriteLn(OutFile, OutSt) ;
  153.      End ;
  154.      Writeln(OutFile, '`') ;       { write an "empty" line }
  155.      WriteLn(OutFile, 'end') ;
  156.  
  157.      Close(OutFile) ;
  158.      Close(InFile) ;
  159. End ;
  160.  
  161. Begin
  162.      If ParamCount<>1 Then
  163.      Begin
  164.           WriteLn('UUE2 <source_file_name>') ;
  165.           Halt(1) ;
  166.      End ;
  167.      Initialise ;
  168.      EncodeFile ;
  169.      Termine ;
  170. End.
  171.